00100	OFF ECHO;
00200	COMMENT MAPP APPLIES A PERMUTATION TO AN ELEMENT.  MAPCY
00300	APPLIES A CYCLE.;
00400	
00500	MAPP(PER,EL) ← IF NULL PER THEN EL 
00600		ELSE IF ATOM CAR PER THEN MAPCY(PER,EL)
00700		ELSE (LAMBDA W; IF W EQ EL THEN MAPP(CDR PER,EL)
00800				ELSE W)
00900			MAPCY(CAR PER,EL);
01000	
01100	MAPCY(CYC,EL) ← IF NOT MEMBER(EL,CYC) OR NULL CDR CYC THEN EL
01200			ELSE IF EL EQ CAR CYC THEN CADR CYC
01300			ELSE MAPCY1(CAR CYC,CDR CYC,EL);
01400	
01500	MAPCY1(X,U,EL) ← 
01600			IF EL EQ CAR U THEN
01700				(IF NULL CDR U THEN X ELSE CADR U)
01800			ELSE MAPCY1(X,CDR U,EL);
01900	
02000	COMMENT  GCYC(U,V,X) IS THE CYCLE IN THE PRODUCT OF THE
02100	PERMUTATIONS  U  AND  V  THAT STARTS WITH  X, BUT IT'S NIL
02200	IF THE CYCLE HAS LENGTH 1.;
02300	
02400	GCYC(U,V,X) ← (LAMBDA W; IF  W EQ X THEN NIL
02500				ELSE X.GCYC1(U,V,X,W))
02600			MAPP(U,MAPP(V,X));
02700	
02800	GCYC1(U,V,X,W) ←  IF W EQ X THEN NIL
02900				ELSE (LAMBDA Z; W . GCYC1(U,V,X,Z))
03000					MAPP(U,MAPP(V,W));
03100	
03200	COMMENT SORT U  IS THE LIST  U  SORTED IN ASCENDING ORDER.  SORT
03300	USES  ENTER(X,U)  WHICH IS THE RESULT OF ENTERING  X  INTO
03400	THE SORTED LIST  U.  SUBT(U,V)  IS THE SET
03500	DIFFERENCE OF THE LISTS  U  AND  V.;
03600	
03700	SORT U ← IF NULL U THEN NIL ELSE ENTER(CAR U,SORT CDR U);
03800	
03900	ENTER(X,U) ← IF NULL U THEN LIST X
04000		ELSE IF X = CAR U THEN U
04100		ELSE IF X > CAR U THEN CAR U . ENTER(X,CDR U)
04200		ELSE X.U;
04300	
04400	SUBT(U,V) ← IF NULL U THEN NIL
04500		ELSE IF CAR U MEMBER V THEN SUBT(CDR U,V)
04600		ELSE CAR U . SUBT(CDR U,V);
04700	
04800	
04900	COMMENT  MERGEA(U,V)  COMBINES THE TWO ORDERED LISTS  U  
05000	AND  V  ELIMINATING DUPLICATIONS.  APPL  U  IS THE RESULT
05100	OF APPENDING THE SUBLISTS OF THE LIST  U.;
05200	
05300	MERGEA(U,V) ← IF NULL U THEN V
05400			ELSE IF NULL V THEN U
05500			ELSE IF CAR U EQ CAR V THEN MERGEA(U,CDR V)
05600			ELSE IF CAR U < CAR V THEN 
05700					CAR U . MERGEA(CDR U,V)
05800			ELSE CAR V . MERGEA(U,CDR V);
05900	
06000	APPL U ← IF NULL U THEN NIL
06100		ELSE IF ATOM CAR U THEN U
06200		ELSE APPEND(CAR U,APPL CDR U);
06300	
06400	COMMENT  MUL(U,V)  IS THE PRODUCT OF THE PERMUTATIONS  U  AND
06500	V.;
06600	
06700	MUL(U,V)← (LAMBDA W; IF NULL W THEN NIL
06800			ELSE IF NULL CDR W THEN CAR W
06900			ELSE W)
07000		MUL1(U,V,MERGEA(SORT APPL U,SORT APPL V));
07100	
07200	MUL1(U,V,L) ← IF NULL L THEN NIL
07300			ELSE (LAMBDA Z; IF NULL Z THEN MUL1(U,V,CDR L)
07400					ELSE Z . MUL1(U,V,SUBT(L,Z)))
07500				GCYC(U,V,CAR L);
07600	
07700	COMMENT  Elements of the group algebra are represented by
07800	lists in which each permutation is preceded by its
07900	coefficient.  Thus 2+3(12)-4(12)(34)  is represented by
08000	(2 NIL 3 (1 2) -4 ((1 2) (3 4))).
08100		prod(u,v) is the product of two elements of the group
08200	algebra with the terms ordered by class and within classes
08300	lexicographically.  A class is represented by a list of
08400	pairs each of which is a cycle length preceded by the
08500	number of cycles of that length.  Thus (5 5 3 3 3 2) is
08600	represented by ((2 5)(3 3)(1 2)).  Ones are not
08700	represented because the algorithms are independent of the
08800	total number of letters being permuted.  A class  c1  precedes
08900	a class  c2  in the ordering if it has a bigger cycle sooner.;
09000	
09100	PROD(U,V) ← PRODA(U,V,NIL);
09200	
09300	PRODA(U,V,L) ← IF NULL U THEN L
09400			ELSE PRODA(CDDR U,V,PRODB(CAR U,CADR U,V,L));
09500	
09600	PRODB(N,PER,V,L) ← IF NULL V THEN L
09700			ELSE PRODB(N,PER,CDDR V,ENTERA(N*(CAR V),
09800					MUL(PER,CADR V),L));
09900	
10000	ENTERA(N,PER,U) ←
10100		IF NULL U THEN LIST(N,PER)
10200		ELSE IF ISPREC(PER,CADR U) THEN N.(PER.U)
10300		ELSE IF PER = CADR U THEN
10400			(LAMBDA W; IF W=0 THEN CDDR U ELSE W.CDR U)
10500				(N + CAR U)
10600		ELSE CAR U . (CADR U . ENTERA(N,PER,CDDR U));
10700	
10800	ISPREC(P1,P2) ←
10900		(LAMBDA C1,C2; IF C1 = C2 THEN ISPRECB(APPL P1,APPL P2)
11000				ELSE ISPRECA(C1,C2))
11100		(CLASS P1,CLASS P2);
11200	
11300	CLASS P ←
11400		IF NULL P THEN NIL
11500		ELSE IF ATOM CAR P THEN LIST LIST(1,LENGTH P)
11600		ELSE ENTERB(LENGTH CAR P,CLASS CDR P);
11700	
11800	ENTERB(N,CL) ←
11900		IF NULL CL THEN LIST LIST(1,N)
12000		ELSE IF N = CADAR CL THEN
12100			(LAMBDA U; IF U=0 THEN CDR CL
12200					ELSE (U. CDAR CL) . CDR CL)
12300			ADD1 CAAR CL
12400		ELSE IF N > CADAR CL THEN LIST(1,N).CL
12500		ELSE CAR CL . ENTERB(N,CDR CL);
12600	
12700	ISPRECB(L1,L2) ←
12800		IF NULL L1 THEN NIL
12900		ELSE IF NULL L2 THEN T
13000		ELSE IF CAR L1 > CAR L2 THEN T
13100		ELSE IF CAR L1 < CAR L2 THEN NIL
13200		ELSE ISPRECB(CDR L1,CDR L2);
13300	
13400	ISPRECA(C1,C2) ←
13500		(LAMBDA M1,M2; IF M1 < M2  THEN NIL
13600			ELSE IF M1=M2 THEN ISPRECC(C1,C2)
13700			ELSE T)
13800		(SIZE C1,SIZE C2);
13900	
14000	SIZE C ← IF NULL C THEN 0 ELSE CAAR C * CADAR C + SIZE CDR C;
14100	
14200	ISPRECC(C1,C2) ←
14300		IF NULL C1 THEN NIL
14400		ELSE IF NULL C2 THEN T
14500		ELSE IF CADAR C1 > CADAR C2 THEN T
14600		ELSE IF CADAR C1 < CADAR C2 THEN NIL
14700		ELSE IF CAAR C1 > CAAR C2 THEN T
14800		ELSE IF CAAR C1 < CAAR C2 THEN NIL
14900		ELSE ISPRECC(CDR C1,CDR C2);
15000	
15100	COMMENT  inv x  is the inverse of the permutation  x.;
15200	
15300	INV X ← MUL(NIL,INVA X);
15400	
15500	INVA X ← 
15600		IF NULL X THEN NIL
15700		ELSE IF ATOM CAR X THEN REVERSE X
15800		ELSE (REVERSE CAR X) . INVA CDR X;
     

00100	INITFN '(LAMBDA NIL (BEGIN));